home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-11-18 | 8.7 KB | 330 lines | [TEXT/PJMM] |
- { *** Unility unit for the "IngisWDEF" WDEF building package *** }
-
- {© 1994-1995 by Ingemar Ragnemalm}
- {You may use it freely as long as credits are given in the final program.}
-
-
- unit IngisWDEFUtils;
-
- interface
- {$IFC UNDEFINED THINK_PASCAL}
- uses Types, QuickDraw, ToolUtils, OSUtils;
- {$ENDC}
-
-
- {Color save and restore}
- function HasCQDraw: Boolean;
- procedure SaveColors (var saveForeColor, saveBackColor: RGBColor);
- procedure RestoreColors (saveForeColor, saveBackColor: RGBColor);
- procedure DefaultColors;
- {Standard colors. For perfect results, you should check out Technote TB33, but I didn't have}
- {THAT much energy.}
- function BoxFillColor: RGBColor;
- function BoxFrameColor: RGBColor;
- function BoxShadowColor: RGBColor;
- function SurroundColor: RGBColor;
- function DraglineColor: RGBColor;
- {Standard drawings, to conform with standard windows}
- procedure DrawStdCloseHit (rclose: Rect);
- procedure StdFrameBox (closeBox: Rect; colorFlag: Boolean);
- procedure StdCloseBox (closeBox: Rect; colorFlag: Boolean);
- procedure StdZoomBox (closeBox: Rect; colorFlag: Boolean);
- procedure StdDragIcon (where: Point; colorFlag: Boolean);
-
- implementation
-
- {*****************************************************************************}
- {Some color stuff, for saving and restoring the foreground and background colors}
- {Called only when we run in color!}
-
- function HasCQDraw: Boolean;
- var
- theWorld: SysEnvRec;
- begin
- HasCQDraw := GetToolTrapAddress($AA1E) <> GetToolTrapAddress($A89F);{_Unimplemented}
-
- (* HasCQDraw := false;
- if SysEnvirons(1, theWorld) = noErr then
- HasCQDraw := theWorld.hasColorQD;*)
- end;
-
- procedure SaveColors (var saveForeColor, saveBackColor: RGBColor);
- begin
- if not HasCQDraw then
- exit(SaveColors);
- GetForeColor(saveForeColor);
- GetBackColor(saveBackColor);
- DefaultColors;
- end;
-
- procedure RestoreColors (saveForeColor, saveBackColor: RGBColor);
- begin
- if not HasCQDraw then
- exit(RestoreColors);
- RGBForeColor(saveForeColor);
- RGBBackColor(saveBackColor);
- end;
-
- procedure DefaultColors;
- var
- tmpCol: RGBColor;
- begin
- if not HasCQDraw then
- exit(DefaultColors);
- {Foreground black}
- tmpCol.red := 0;
- tmpCol.green := 0;
- tmpCol.blue := 0;
- RGBForeColor(tmpCol);
- {Background white}
- tmpCol.red := -1;
- tmpCol.green := -1;
- tmpCol.blue := -1;
- RGBBackColor(tmpCol);
- end;
-
- {Standard bluish colors.}
- function BoxFillColor: RGBColor;
- begin
- BoxFillColor.red := 43690;
- BoxFillColor.green := 43690;
- BoxFillColor.blue := 43690;
- end;
- function BoxFrameColor: RGBColor;
- begin
- BoxFrameColor.red := 52428;
- BoxFrameColor.green := 52428;
- BoxFrameColor.blue := 65535; {=-1=$ffff}
- end;
- function BoxShadowColor: RGBColor;
- begin
- BoxShadowColor.red := 13107;
- BoxShadowColor.green := 13107;
- BoxShadowColor.blue := 26214;
- end;
- function SurroundColor: RGBColor;
- begin
- SurroundColor.red := 61166;
- SurroundColor.green := 61166;
- SurroundColor.blue := 61166;
- end;
- function DraglineColor: RGBColor;
- begin
- DraglineColor.red := 30583;
- DraglineColor.green := 30583;
- DraglineColor.blue := 30583;
- end;
- {--------}
-
- {Draws the standard "hit" icon. Looks best in the standard size.}
- {Set colors before calling it, if color is desired (i.e. possible)}
- procedure DrawStdCloseHit (rclose: Rect);
- begin
- EraseRect(rclose);
- FrameRect(rclose);
- MoveTo(rclose.left + 2, rclose.top + 2);
- LineTo(rclose.right - 3, rclose.bottom - 3);
- MoveTo(rclose.left + 2, rclose.bottom - 3);
- LineTo(rclose.right - 3, rclose.top + 2);
- MoveTo(rclose.left + 1, (rclose.top + rclose.bottom) div 2);
- Line(rclose.right - rclose.left - 2, 0);
- MoveTo((rclose.right + rclose.left) div 2, rclose.top + 1);
- Line(0, rclose.bottom - rclose.top - 2);
- InsetRect(rclose, 4, 4);
- EraseRect(rclose);
- end;
-
- procedure StdFrameBox (closeBox: Rect; colorFlag: Boolean);
- begin
- if colorFlag then
- begin
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(BoxShadowColor());
- RGBBackColor(BoxFillColor());
- {$ELSEC}
- RGBForeColor(BoxShadowColor);
- RGBBackColor(BoxFillColor);
- {$ENDC}
- EraseRect(closeBox);
- FrameRect(closeBox);
- OffsetRect(closeBox, 1, 1);
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(BoxFrameColor());
- {$ELSEC}
- RGBForeColor(BoxFrameColor);
- {$ENDC}
- FrameRect(closeBox);
- end
- else
- begin
- FrameRect(closeBox);
- InsetRect(closeBox, 1, 1);
- EraseRect(closeBox);
- end;
- end;
-
- procedure StdCloseBox (closeBox: Rect; colorFlag: Boolean);
- begin
- if colorFlag then
- begin
- InsetRect(closeBox, -1, -1); { Make an empty frame around it }
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(SurroundColor());
- {$ELSEC}
- RGBForeColor(SurroundColor);
- {$ENDC}
- FrameRect(closeBox);
- InsetRect(closeBox, 1, 1);
-
- closeBox.right := closeBox.right - 1;
- closeBox.bottom := closeBox.bottom - 1;
-
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(BoxShadowColor());
- RGBBackColor(BoxFillColor());
- {$ELSEC}
- RGBForeColor(BoxShadowColor);
- RGBBackColor(BoxFillColor);
- {$ENDC}
- EraseRect(closeBox);
- MoveTo(closeBox.left, closeBox.bottom);
- LineTo(closeBox.left, closeBox.top);
- LineTo(closeBox.right, closeBox.top);
- MoveTo(closeBox.left + 2, closeBox.bottom - 1);
- LineTo(closeBox.right - 1, closeBox.bottom - 1);
- LineTo(closeBox.right - 1, closeBox.top + 2);
-
- OffsetRect(closeBox, 1, 1);
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(BoxFrameColor());
- {$ELSEC}
- RGBForeColor(BoxFrameColor);
- {$ENDC}
- FrameRect(closeBox);
- end
- else
- begin
- InsetRect(closeBox, -1, -1); { Blast a hole in the drag bar }
- EraseRect(closeBox); { pattern }
- InsetRect(closeBox, 1, 1);
- FrameRect(closeBox); { Now draw the close box }
- end;
- end;
-
- procedure StdZoomBox (closeBox: Rect; colorFlag: Boolean);
- begin
- if colorFlag then
- begin
- InsetRect(closeBox, -1, -1); { Make an empty frame around it }
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(SurroundColor());
- {$ELSEC}
- RGBForeColor(SurroundColor);
- {$ENDC}
- FrameRect(closeBox);
- InsetRect(closeBox, 1, 1);
-
- closeBox.right := closeBox.right - 1;
- closeBox.bottom := closeBox.bottom - 1;
-
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(BoxShadowColor());
- RGBBackColor(BoxFillColor());
- {$ELSEC}
- RGBForeColor(BoxShadowColor);
- RGBBackColor(BoxFillColor);
- {$ENDC}
- EraseRect(closeBox);
- MoveTo(closeBox.left, closeBox.bottom);
- LineTo(closeBox.left, closeBox.top);
- LineTo(closeBox.right, closeBox.top);
- MoveTo(closeBox.left + 2, closeBox.bottom - 1);
- LineTo(closeBox.right - 1, closeBox.bottom - 1);
- LineTo(closeBox.right - 1, closeBox.top + 2);
-
- MoveTo(closeBox.left + 2, closeBox.bottom - 1 - 3);
- LineTo(closeBox.right - 1 - 3, closeBox.bottom - 1 - 3);
- LineTo(closeBox.right - 1 - 3, closeBox.top + 2);
-
- OffsetRect(closeBox, 1, 1);
- {$IFC UNDEFINED THINK_PASCAL}
- RGBForeColor(BoxFrameColor());
- {$ELSEC}
- RGBForeColor(BoxFrameColor);
- {$ENDC}
- FrameRect(closeBox);
- end
- else
- begin
- InsetRect(closeBox, -1, -1); { Blast a hole in the drag bar }
- EraseRect(closeBox); { pattern }
- InsetRect(closeBox, 1, 1);
- FrameRect(closeBox); { Now draw the close box }
- MoveTo(closeBox.left + 1, closeBox.bottom - 1 - 4);
- LineTo(closeBox.right - 1 - 4, closeBox.bottom - 1 - 4);
- LineTo(closeBox.right - 1 - 4, closeBox.top + 1);
- end;
- end;
-
- procedure StdDragIcon (where: Point; colorFlag: Boolean);
- var
- tmpRect, smallRect, largeRect: Rect;
-
- procedure FrameBox (box: Rect);
- begin
- FrameRect(box);
- InsetRect(box, 1, 1);
- EraseRect(box);
- end;
-
- begin
- if colorFlag then
- begin
- SetRect(smallRect, where.h + 2, where.v + 2, where.h + 8, where.v + 8);
- SetRect(largeRect, smallRect.left + 1, smallRect.top + 1, smallRect.right + 4, smallRect.bottom + 4);
-
- {Draw the two boxes on top of each other}
-
- {$IFC UNDEFINED THINK_PASCAL}
- RGBBackColor(BoxFillColor());
- RGBForeColor(BoxShadowColor());
- FrameBox(largeRect);
- OffsetRect(largeRect, 1, 1);
- RGBForeColor(BoxFrameColor());
-
- FrameRect(largeRect);
-
- RGBBackColor(BoxFillColor());
- RGBForeColor(BoxShadowColor());
- FrameBox(smallRect);
- OffsetRect(smallRect, 1, 1);
- RGBForeColor(BoxFrameColor());
- {$ELSEC}
- RGBBackColor(BoxFillColor);
- RGBForeColor(BoxShadowColor);
- FrameBox(largeRect);
- OffsetRect(largeRect, 1, 1);
- RGBForeColor(BoxFrameColor);
-
- FrameRect(largeRect);
-
- RGBBackColor(BoxFillColor);
- RGBForeColor(BoxShadowColor);
- FrameBox(smallRect);
- OffsetRect(smallRect, 1, 1);
- RGBForeColor(BoxFrameColor);
- {$ENDC}
- FrameRect(smallRect);
- end
- else
- begin
- SetRect(smallRect, where.h + 2, where.v + 2, where.h + 9, where.v + 9);
- SetRect(largeRect, smallRect.left + 2, smallRect.top + 2, smallRect.right + 4, smallRect.bottom + 4);
-
- FrameBox(largeRect);
- FrameBox(smallRect);
- end;
-
- end;
-
- end.